library(skimr)
library(flextable)
library(ggbeeswarm)
library(rstatix)
library(corrplot)
library(corrr)
library(GGally)
library(factoextra)
library(pheatmap)
library(embed)
library(FactoMineR)
library(tidyverse)
library(readxl)
library(openxlsx)
library(dplyr)
library(ggplot2)
library(plotly)
library(ggpubr)
library(devtools)
install_github("vqv/ggbiplot")
#1
data <- readRDS("life_expectancy_data.RDS")
data %>%
glimpse()
## Rows: 195
## Columns: 23
## $ Country <chr> "Afghanistan", "Albania", "A…
## $ Year <int> 2019, 2019, 2019, 2019, 2019…
## $ Gender <chr> "Female", "Female", "Female"…
## $ `Life expectancy` <dbl> 66.388, 80.201, 78.133, 64.0…
## $ Unemployment <dbl> 14.065000, 11.322000, 18.629…
## $ `Infant Mortality` <dbl> 42.90000, 7.70000, 18.60000,…
## $ GDP <dbl> 1.879945e+10, 1.540024e+10, …
## $ GNI <dbl> 1.909831e+10, 1.519866e+10, …
## $ `Clean fuels and cooking technologies` <dbl> 36.00000, 80.70000, 99.30000…
## $ `Per Capita` <dbl> 494.1793, 5395.6595, 3989.66…
## $ `Mortality caused by road traffic injury` <dbl> 15.90000, 11.70000, 20.90000…
## $ `Tuberculosis Incidence` <dbl> 189.0, 16.0, 61.0, 351.0, 0.…
## $ `DPT Immunization` <dbl> 66.00000, 99.00000, 91.00000…
## $ `HepB3 Immunization` <dbl> 66.00000, 99.00000, 91.00000…
## $ `Measles Immunization` <dbl> 64.00000, 95.00000, 80.00000…
## $ `Hospital beds` <dbl> 0.4322222, 3.0523077, 1.8000…
## $ `Basic sanitation services` <dbl> 49.00617, 99.18307, 86.13850…
## $ `Tuberculosis treatment` <dbl> 91.00000, 88.00000, 86.00000…
## $ `Urban population` <dbl> 25.754, 61.229, 73.189, 66.1…
## $ `Rural population` <dbl> 74.246, 38.771, 26.811, 33.8…
## $ `Non-communicable Mortality` <dbl> 36.20000, 6.00000, 12.80000,…
## $ `Sucide Rate` <dbl> 3.60000, 2.70000, 1.80000, 2…
## $ continent <fct> Asia, Europe, Africa, Africa…
#2
plot_ly(
d = data[(data$`Life expectancy`!= 0) & (data$`Mortality caused by road traffic injury` != 0),],
x = ~ `Urban population`,
y = ~ `Mortality caused by road traffic injury`,
color = ~continent,
marker = list(
size = 9,
line = list(color = 'rgba(152, 0, 0, .6)',
width = 1)
)
) %>%
layout(
title = 'Отношение населения в городе и сметрностью от аварий',
yaxis = list(title = 'Население в городе',
zeroline = FALSE),
xaxis = list(title = 'Смертность от аварий',
zeroline = FALSE))
#3
data %>%
select('Life expectancy', 'continent') %>%
filter(continent == "Africa" | continent == "Americas") -> data_life
t_test(data = data_life, formula = `Life expectancy` ~ continent)
## # A tibble: 1 × 8
## .y. group1 group2 n1 n2 statistic df p
## * <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl>
## 1 Life expectancy Africa Americas 52 38 -12.3 85.8 1.31e-20
stat.test <- data_life %>%
group_by(continent) %>%
t_test(data = data_life, formula = `Life expectancy` ~ continent) %>%
adjust_pvalue(method = "bonferroni") %>%
add_significance("p.adj")
stat.test
## # A tibble: 1 × 10
## .y. group1 group2 n1 n2 statistic df p p.adj p.adj.signif
## <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 Life… Africa Ameri… 52 38 -12.3 85.8 1.31e-20 1.31e-20 ****
bxp <- ggboxplot(
data_life, y = "Life expectancy", x = "continent",
palette = c("#00AFBB", "#E7B800")
)
stat.test <- stat.test %>%
add_xy_position(x = "Life expectancy", dodge = 0.8)
bxp + stat_pvalue_manual(
stat.test, label = "p", tip.length = 0
)
#4
data2 <- data %>% select(!Year) %>% select(where(is.numeric))
data_cor <- cor(data2)
corrplot(data_cor, method = 'color', type = "lower")
data_cor %>%
rplot()
#5
data3 <- scale(data2)
data4 <- dist(data3,
method = "euclidean"
)
as.matrix(data4)[1:6,1:6]
## 1 2 3 4 5 6
## 1 0.000000 7.605708 6.331840 4.414874 6.645623 7.923487
## 2 7.605708 0.000000 2.624659 7.921597 3.357361 3.631018
## 3 6.331840 2.624659 0.000000 6.321666 4.350331 3.464837
## 4 4.414874 7.921597 6.321666 0.000000 8.095849 7.161240
## 5 6.645623 3.357361 4.350331 8.095849 0.000000 4.966244
## 6 7.923487 3.631018 3.464837 7.161240 4.966244 0.000000
data5 <- hclust(d = data4,
method = "ward.D2")
fviz_dend(data5,
cex = 0.1)
#6
pheatmap(data3,
show_rownames = FALSE,
clustering_distance_rows = data4,
clustering_method = "ward.D2",
cutree_rows = 10,
cutree_cols = length(colnames(data3)),
angle_col = 45,
main = "clustering rows and columns with heatmap")
#7
data_full <- prcomp(data3,
scale = T)
summary(data_full)
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.7526 1.4841 1.3952 1.17177 1.08375 0.96347 0.9288
## Proportion of Variance 0.3988 0.1159 0.1025 0.07227 0.06182 0.04886 0.0454
## Cumulative Proportion 0.3988 0.5147 0.6172 0.68945 0.75126 0.80012 0.8455
## PC8 PC9 PC10 PC11 PC12 PC13 PC14
## Standard deviation 0.85740 0.69263 0.68937 0.59106 0.54986 0.47085 0.36596
## Proportion of Variance 0.03869 0.02525 0.02501 0.01839 0.01591 0.01167 0.00705
## Cumulative Proportion 0.88421 0.90946 0.93447 0.95286 0.96877 0.98044 0.98749
## PC15 PC16 PC17 PC18 PC19
## Standard deviation 0.34546 0.26941 0.20224 0.06968 9.125e-16
## Proportion of Variance 0.00628 0.00382 0.00215 0.00026 0.000e+00
## Cumulative Proportion 0.99377 0.99759 0.99974 1.00000 1.000e+00
#Cumulative Proportion - PC1, PC2 и PC3 чуть больше 60%, для первых двух - 51, не слишком хороший результат
fviz_eig(data_full, addlabels = T, ylim = c(0, 40))
#Выдел 1-я комп - 39,9%
fviz_pca_var(data_full, col.var = "contrib")
fviz_pca_var(data_full,
select.var = list(contrib = 8),
col.var = "contrib")
fviz_contrib(data_full, choice = "var", axes = 1, top = 24)
fviz_contrib(data_full, choice = "var", axes = 2, top = 24)
fviz_contrib(data_full, choice = "var", axes = 3, top = 24)
#PC1 много переменных, основных - 4
#PC2 составляют в первую очередь переменные иммунизаций
#PC3 состоит из GDP и GNI
#8
ggbiplot::ggbiplot(data_full,
scale=0, alpha = 0.1, varname.size = 4, groups = data$continent, labels = data$Country, labels.size = 1, ellipse = T) +
theme_minimal() -> PCA_biplot
ggplotly(PCA_biplot, tooltip = c("groups", "labels"))
#9
#Существует 3 основных компонента. Первый компонент включает в себя сразу несколько различных показателей (основной из них - ожидаемая продолжительность жизни), второй - показатели иммунизации (они хорошо коррелируют), третий компонент состоит из ВВП и ВНД, и они сильно коррелируют, хотя их вклад заметно меньше, чем у других переменных (за исключением самоубийств, безработицы и лечение туберкулеза) Такие показатели, как городское и сельское население, противоположно направлены, но вносят одинаковый вклад. В то же время показатель на душу населения в расчете на столицу совпадает с показателем городского населения в этом направлении, но вносит несколько меньший вклад.
#10
umap <- recipe(~., data = data2) %>%
step_normalize(all_predictors()) %>%
step_umap(all_predictors()) %>%
prep() %>%
juice()
umap2 <- cbind(umap, data)
umap2 %>%
ggplot(aes(UMAP1, UMAP2)) +
geom_point(aes(color = continent,
alpha = 0.6, size = 2)) +
labs(color = NULL)
#В UMAP прослеживается тенденция, что данные внутри региона близки друг к другу, потому на получившемся графике точки группируются по регионам